home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / attall / atomic.frm < prev    next >
Text File  |  1995-05-07  |  12KB  |  425 lines
  1. VERSION 2.00
  2. Begin Form Atomic 
  3.    BackColor       =   &H00C0C0C0&
  4.    BorderStyle     =   3  'Fixed Double
  5.    Caption         =   "Call the Atomic Clock"
  6.    ClientHeight    =   3915
  7.    ClientLeft      =   2460
  8.    ClientTop       =   930
  9.    ClientWidth     =   4725
  10.    Height          =   4320
  11.    Left            =   2400
  12.    LinkTopic       =   "Form1"
  13.    MaxButton       =   0   'False
  14.    MinButton       =   0   'False
  15.    ScaleHeight     =   3915
  16.    ScaleWidth      =   4725
  17.    Top             =   585
  18.    Width           =   4845
  19.    Begin MSComm Comm1 
  20.       Interval        =   1000
  21.       Left            =   3390
  22.       Top             =   1125
  23.    End
  24.    Begin SSCheck DST 
  25.       Caption         =   "Use Daylight Savings Time"
  26.       Font3D          =   0  'None
  27.       Height          =   285
  28.       Left            =   225
  29.       TabIndex        =   4
  30.       Top             =   960
  31.       Width           =   2640
  32.    End
  33.    Begin ComboBox TimeZone 
  34.       BackColor       =   &H00FFFFFF&
  35.       Height          =   300
  36.       Left            =   375
  37.       Style           =   2  'Dropdown List
  38.       TabIndex        =   3
  39.       Top             =   450
  40.       Width           =   4065
  41.    End
  42.    Begin CommandButton Command1 
  43.       Cancel          =   -1  'True
  44.       Caption         =   "Cancel"
  45.       Height          =   345
  46.       Index           =   2
  47.       Left            =   2370
  48.       TabIndex        =   1
  49.       Top             =   3300
  50.       Width           =   2085
  51.    End
  52.    Begin CommandButton Command1 
  53.       Caption         =   "Dial"
  54.       Default         =   -1  'True
  55.       Height          =   345
  56.       Index           =   1
  57.       Left            =   2370
  58.       TabIndex        =   0
  59.       Top             =   2790
  60.       Width           =   2070
  61.    End
  62.    Begin CommandButton Command1 
  63.       Caption         =   "Reset Defaults"
  64.       Height          =   345
  65.       Index           =   0
  66.       Left            =   2370
  67.       TabIndex        =   12
  68.       Top             =   2280
  69.       Width           =   2070
  70.    End
  71.    Begin SSFrame Frame3D1 
  72.       Caption         =   "COM Port"
  73.       Font3D          =   0  'None
  74.       ForeColor       =   &H00000000&
  75.       Height          =   1530
  76.       Left            =   255
  77.       TabIndex        =   7
  78.       Top             =   2190
  79.       Width           =   1965
  80.       Begin SSOption ComPort 
  81.          Caption         =   "COM&4:"
  82.          Font3D          =   0  'None
  83.          ForeColor       =   &H00000000&
  84.          Height          =   240
  85.          Index           =   3
  86.          Left            =   135
  87.          TabIndex        =   11
  88.          Top             =   1185
  89.          Width           =   780
  90.       End
  91.       Begin SSOption ComPort 
  92.          Caption         =   "COM&3:"
  93.          Font3D          =   0  'None
  94.          ForeColor       =   &H00000000&
  95.          Height          =   240
  96.          Index           =   2
  97.          Left            =   135
  98.          TabIndex        =   10
  99.          Top             =   885
  100.          Width           =   780
  101.       End
  102.       Begin SSOption ComPort 
  103.          Caption         =   "COM&2:"
  104.          Font3D          =   0  'None
  105.          ForeColor       =   &H00000000&
  106.          Height          =   240
  107.          Index           =   1
  108.          Left            =   135
  109.          TabIndex        =   9
  110.          Top             =   585
  111.          Width           =   780
  112.       End
  113.       Begin SSOption ComPort 
  114.          Caption         =   "COM&1:"
  115.          Font3D          =   0  'None
  116.          ForeColor       =   &H00000000&
  117.          Height          =   240
  118.          Index           =   0
  119.          Left            =   135
  120.          TabIndex        =   8
  121.          Top             =   285
  122.          Width           =   780
  123.       End
  124.    End
  125.    Begin TextBox DialString 
  126.       Height          =   300
  127.       Left            =   375
  128.       TabIndex        =   6
  129.       Text            =   "ATDT 1 303 494-4774"
  130.       Top             =   1710
  131.       Width           =   4080
  132.    End
  133.    Begin Label Status 
  134.       Alignment       =   1  'Right Justify
  135.       BackStyle       =   0  'Transparent
  136.       Height          =   240
  137.       Left            =   1125
  138.       TabIndex        =   13
  139.       Top             =   15
  140.       Width           =   3300
  141.    End
  142.    Begin Label Label1 
  143.       BackStyle       =   0  'Transparent
  144.       Caption         =   "Modem Dial String"
  145.       Height          =   210
  146.       Index           =   1
  147.       Left            =   225
  148.       TabIndex        =   5
  149.       Top             =   1440
  150.       Width           =   2145
  151.    End
  152.    Begin Label Label1 
  153.       BackStyle       =   0  'Transparent
  154.       Caption         =   "Time Zone"
  155.       Height          =   240
  156.       Index           =   0
  157.       Left            =   195
  158.       TabIndex        =   2
  159.       Top             =   165
  160.       Width           =   1320
  161.    End
  162. End
  163. Option Explicit
  164. Declare Function GetProfileString Lib "Kernel" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer) As Integer
  165.  
  166. Dim ControlsDisabled As Integer
  167. Dim InString As String
  168. Dim TString As String
  169. Dim Aborted As Integer
  170.  
  171. Sub Command1_Click (Index As Integer)
  172. Dim StartTime As Double
  173. Dim I As Integer
  174. Dim NewD As Double
  175. Dim OldD As Double
  176. Dim DSTFlag As String
  177. Dim OffBy As String
  178.  
  179. If Index = 0 Then  'Reset Defaults
  180.    ResetDefaults
  181.    Status.Caption = ""
  182. End If
  183.  
  184. If Index = 1 Then  'Dial
  185.    SaveModemSettings
  186.    Aborted = False
  187.    Status.Caption = ""
  188.  
  189.    Command1(0).Enabled = False
  190.    Command1(1).Enabled = False
  191.    TimeZone.Enabled = False
  192.    DST.Enabled = False
  193.    DialString.Enabled = False
  194.    Frame3D1.Enabled = False
  195.    ControlsDisabled = True
  196.    On Local Error GoTo ErrHndl
  197.    For I% = 0 To 3
  198.      If ComPort(I%).Value Then comm1.CommPort = I% + 1
  199.    Next I%
  200.    If Aborted Then Exit Sub
  201.    comm1.Settings = "1200,N,8,1"
  202.    If Aborted Then Exit Sub
  203.    comm1.PortOpen = True
  204.    If Aborted Then Exit Sub
  205.    comm1.Output = DialString.Text + Chr$(13) + Chr(10)
  206.    StartTime = Timer
  207.    LastTime = 0
  208.    Do
  209.       DoEvents
  210.       If LastTime <> Int(Timer) Then
  211.          If Not Aborted Then Status.Caption = "Connecting - " + Format$(45 - Int(Timer - StartTime)) + " seconds until timeout."
  212.          LastTime = Int(Timer)
  213.       End If
  214.    Loop Until comm1.InBufferCount >= 600 Or ((Timer - StartTime) > 45) Or Aborted
  215.    If Aborted Then Exit Sub
  216.    
  217.    If (Timer - StartTime) > 45 Then
  218.          Status.Caption = "Timed out."
  219.          Exit Sub
  220.    End If
  221.    
  222.    Status.Caption = "Setting time."
  223.    InString$ = comm1.Input
  224.    If Aborted Then Exit Sub
  225.    InString$ = Mid$(InString$, InStr(InString$, "*") + 1, 80)
  226.     
  227.  
  228.    NewD = DateValue(Mid$(InString$, 12, 2) + "/" + Mid$(InString$, 15, 2) + "/" + Mid$(InString$, 9, 2))
  229.    NewD = NewD + TimeValue(Mid$(InString$, 18, 8))
  230.    
  231.    NewD = NewD - (TimeZone.ListIndex - 11) * (1 / 24)
  232.    DSTFlag$ = Mid$(InString$, 27, 2)
  233.    If ((DSTFlag >= "01") And (DSTFlag <= "50")) Then
  234.       NewD = NewD - (1 / 24)
  235.    End If
  236.    If DST.Value Then
  237.       NewD = NewD + (1 / 24)
  238.    End If
  239.    OldD = Date + Time
  240.    If Year(NewD) >= 1993 Then
  241.       Date = Format$(NewD, "mm/dd/yy")
  242.       Time = Format$(NewD, "hh:mm:ss")
  243.       If OldD > NewD Then
  244.          OffBy = "fast"
  245.       Else
  246.          OffBy = "slow"
  247.       End If
  248.       MsgBox "Time set to " + Format$(NewD, "hh:mm:ss") + ".  Clock was " + OffBy$ + " by " + Format$(Abs(NewD - OldD), "hh:mm:ss") + "."
  249.       AtomicTimeWasSet = True
  250.       Status.Caption = "Time set."
  251.    Else
  252.       MsgBox "Error getting date and time."
  253.    End If
  254.    
  255.    If Aborted Then Exit Sub
  256.    HangUp
  257.    If Aborted Then Exit Sub
  258.    On Local Error Resume Next
  259.    
  260.    Unload Atomic
  261.  
  262. End If
  263.  
  264. If Index = 2 Then  'Cancel
  265.    If ControlsDisabled Then
  266.       HangUp
  267.       EnableControls
  268.       Aborted = True
  269.       Status.Caption = "Aborted."
  270.    Else
  271.       Unload Atomic
  272.    End If
  273. End If
  274.  
  275. EnableControls
  276. Exit Sub
  277.  
  278.  
  279. ErrHndl:
  280. MsgBox "Error: " + Error(Err)
  281. EnableC